home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0021_multitasking program.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  2KB  |  82 lines
  1. {
  2. YC> Does anyone got any unit/code on giving up time slice under DV or OS/2?
  3. Here they are for DOS, Windows, OS/2, DV and DoubleDos.  You will need
  4. to detect the enviroment first (although none should make the system
  5. hang if it's the wrong enviroment, just be ignored)  The key to good
  6. idle release is finding the right spots to put them.  I have gotten my
  7. door making unit that I created to about 97% idle during pauses and 93%
  8. idle while waiting for keyboard input (with no delay in response - much
  9. better than the typical 12% idle pauses and 8% idle keyboard waits)
  10. Here is how... }
  11.  
  12. Procedure Sleep(Seconds: Word);
  13. Var
  14.   H,M,S,T,Last: Word;
  15. Begin
  16.   If Seconds = 0 Then Exit;
  17.   If Seconds > 999 Then Seconds := Seconds DIV 1000;
  18.   {incase of caller is thinking milliseconds}
  19.  
  20.   GetTime(H,M,Last,T);
  21.   Repeat
  22.     Repeat
  23.       GetTime(H,M,S,T);
  24.       TimerSlice;
  25.       TimerSlice;
  26.     Until S <> Last;
  27.     Last := S;
  28.     Dec(Seconds);
  29.   Until Seconds = 0;
  30. End;
  31.  
  32. Function GetChar: Char;
  33. Var
  34.   Counter, Span: Byte;
  35.   Done: Boolean;
  36. Begin
  37.   Span := 0;
  38.   Done := False;
  39.   Repeat
  40.     Inc(Counter);
  41.     If Counter > Span Then
  42.       Begin
  43.         Counter := 0;
  44.         If IsChar Then Done := True
  45.         Else If Span < 50 Then Inc(Span);
  46.       End
  47.     Else TimerSlice;
  48.   Until Done;
  49.   If KeyPressedExtended Then GetChar := Readkey
  50.   Else GetChar := RxChar;
  51. End;
  52.  
  53. Procedure TimerSlice;
  54. Begin
  55.   Case SystemEnviroment Of
  56.     DOS4:;
  57.     DOS5,
  58.     WINDOWS,
  59.     OS2: Asm
  60.            MOV AX,$1680
  61.            INT $2F
  62.          End;
  63.     DV: Asm
  64.           MOV AX,$1000
  65.           INT $15
  66.         End;
  67.     DOUBLEDOS: Asm
  68.                  MOV AX,$EE01
  69.                  INT $21
  70.                End;
  71.   End;
  72. End;
  73.  
  74. This is released as public domain, however if you are using it, I'd
  75. appreciate a PRIVATE NETMAIL message to me at 1:2401/123 letting me
  76. know.
  77.  
  78. Thanks
  79.  
  80. Pete Rocca
  81. Multiboard Communications Centre @ 1:2401/123
  82.